home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / docref.el.z / docref.el
Encoding:
Text File  |  1998-05-21  |  10.0 KB  |  285 lines
  1. ;;; docref.el --- Simple cross references for Elisp documentation strings
  2. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Vadim Geshel <vadik@unas.cs.kiev.ua>
  5. ;; Created: 12 Jul 1994
  6. ;; Keywords: docs, help, lisp
  7. ;; original name was cross-ref.el.
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24. ;; 02111-1307, USA.
  25.  
  26. ;;; Synched up with: FSF 19.34.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; This package allows you to use a simple form of cross references in
  31. ;; your Emacs Lisp documentation strings. Cross-references look like
  32. ;; \\(type@[label@]data), where type defines a method for retrieving
  33. ;; reference informatin, data is used by a method routine as an argument,
  34. ;; and label "represents" the reference in text. If label is absent, data
  35. ;; is used instead.
  36. ;; 
  37. ;; Special reference labeled `back', when present, can be used to return
  38. ;; to the previous contents of help buffer.
  39. ;;
  40. ;; Cross-referencing currently is intended for use in doc strings only
  41. ;; and works only in temporary buffers (created by `with-output-to-temp-buffer').
  42. ;; List of temp buffers in which cross-referencing is to be active is specified
  43. ;; by variable DOCREF-BUFFERS-LIST, which contains only "*Help*" by default.
  44. ;;
  45. ;; Documentation strings for this package's functions and variables can serve
  46. ;; as examples of usage.
  47. ;;
  48. ;;; Customization:
  49. ;; 
  50. ;; See source. The main customization variable is `docref-methods-alist'.
  51. ;; It consists of (type . function) pairs, where type is a string which
  52. ;; corresponds to type in cross-references and function is called with
  53. ;; one argument - reference `data' - when a reference is activated.
  54. ;;
  55. ;;; Installation:
  56. ;;
  57. ;; Place this file somewhere in your load-path, byte-compiled it, and add
  58. ;; (require 'cross-ref)
  59. ;; to your .emacs.
  60.  
  61. ;;; Code:
  62.  
  63. ;; User customizable variables
  64.  
  65. (defvar docref-highlight-p t
  66.   "*If non-nil, \\(f@docref-subst) highlights cross-references.
  67. Under window system it highlights them with face defined by
  68. \\(v@docref-highlight-face), on character terminal highlighted references
  69. look like cross-references in info mode.")
  70.  
  71. (defvar docref-highlight-face 'highlight
  72.   "*Face used to highlight cross-references (used by \\(f@docref-subst))")
  73.  
  74. (defvar docref-methods-alist
  75.   '(("f" . docref-describe-function)    ; reference to a function documentation
  76.     ("v" . docref-describe-variable)    ; reference to a variable documentation
  77.     ("F" . docref-read-file)        ; reference to a file contents
  78.     ("s" . docref-use-string)        ; reference to a string 
  79.     ("V" . docref-use-variable-value)    ; reference to variable value
  80.     ("0" . beep))            ; just highlighted text
  81.   "Alist which maps cross-reference ``types'' to retrieval functions.
  82.  
  83. The car of each element is a string that serves as `type' in cross-references.
  84. \(See \\(f@docref-subst)).  The cdr is a function of one argument,
  85. to be called to find this reference.")
  86.  
  87. (defvar docref-back-label "\nback"
  88.   "Label to use by \\(f@docref-subst) for the go-back reference.")
  89.  
  90. (defvar docref-back-reference nil
  91.   "If non-nil, this is a go-back reference to add to the current buffer.
  92. The value specifies how to go back.  It should be suitable for use
  93. as the second argument to \\(f@docref-insert-label).
  94. \\(f@docref-subst) uses this to set up the go-back reference.")
  95.  
  96. (defvar docref-last-active-buffer)
  97.  
  98. ;;;###autoload
  99. (defun docref-setup ()
  100.   "Process docref cross-references in the current buffer.
  101. See also \\(f@docref-subst)."
  102.   (interactive)
  103.   (docref-subst (current-buffer))
  104.   (docref-mode))
  105.  
  106. (defvar docref-mode-map nil)
  107. (or docref-mode-map
  108.     (let ((map (make-sparse-keymap)))
  109.       (define-key map [mouse-2] 'docref-follow-mouse)
  110.       (define-key map "\C-c\C-b" 'docref-go-back)
  111.       (define-key map "\C-c\C-c" 'docref-follow)
  112.       (setq docref-mode-map map)))
  113.  
  114. (defun docref-mode ()
  115.   "Major mode for help buffers that contain cross references.
  116. To follow a reference, move to it and type \\[docref-follow], or use
  117. \\[docref-follow-mouse].  The command \\[docref-go-back] can used to go
  118. back to where you came from."
  119.   (interactive)
  120.   (kill-all-local-variables)
  121.   (setq major-mode 'docref-mode)
  122.   (setq mode-name "Docref")
  123.   (use-local-map docref-mode-map)
  124.   (run-hooks 'docref-mode))
  125.  
  126. (defun docref-subst (buf)
  127.   "Parse documentation cross-references in buffer BUF.
  128.  
  129. Find cross-reference information in a buffer and
  130. highlight them with face defined by \\(v@docref-highlight-face).
  131.  
  132. Cross-reference has the following format: \\ (TYPE[@LABEL]@DATA), where
  133. TYPE defines method used to retrieve xref data (like reading from file or
  134. calling \\(f@describe-function)), DATA is an argument to this method
  135. \(like file name or function name), and LABEL is displayed in text using
  136. \\(v@docref-highlight-face).
  137.  
  138. The special reference `back' can be used to return back.
  139. The variable \\(v@docref-back-label) specifies the label to use for that.
  140.  
  141. See \\(v@docref-methods-alist) for currently defined methods."
  142.   (interactive "b")
  143.   (save-excursion
  144.     (set-buffer buf)
  145.     (goto-char (point-min))
  146.     ;; The docref-seen property indicates that we have processed this
  147.     ;; buffer's contents already, so don't do it again.
  148.     (if (not (get-text-property (point-min) 'docref-seen))
  149.     (let ((old-modified (buffer-modified-p)))
  150.       (while (re-search-forward "[\\](\\([^\)\@]+\\)\\(@[^\)\@]+\\)?@\\([^\)]*\\))"
  151.                     nil t)
  152.         (let* ((start (match-beginning 0))
  153.            (type (buffer-substring (match-beginning 1) (match-end 1)))
  154.            (data (buffer-substring (match-beginning 3) (match-end 3)))
  155.            (label
  156.             (if (match-beginning 2)
  157.             (buffer-substring (+ (match-beginning 2) 1) (match-end 2))
  158.               data)))
  159.           (replace-match "" t)
  160.           (docref-insert-label label (cons type data))))
  161.  
  162.       ;; Make a back-reference in this buffer, if desired.
  163.       ;; (This is true if called from docref-follow.)
  164.       (if docref-back-reference
  165.           (progn
  166.         (goto-char (point-max))
  167.         (put-text-property (point-min) (1+ (point-min))
  168.                    'docref-back-position (point))
  169.         (docref-insert-label docref-back-label docref-back-reference)))
  170.       (put-text-property (point-min) (1+ (point-min)) 'docref-seen t)
  171.       (set-buffer-modified-p old-modified)))))
  172.  
  173. (defun docref-insert-label (string ref)
  174.   (let ((label (concat string))
  175.     (pos (point)))
  176.     ;; decorate the label
  177.     (let ((leading-space-end (save-match-data
  178.                    (if (string-match "^\\([ \t\n]+\\)" label)
  179.                    (match-end 1)
  180.                  0)))
  181.       (trailing-space-start (save-match-data
  182.                   (if (string-match "\\([ \t\n]+\\)$" label)
  183.                       (match-beginning 1)
  184.                     (length label)))))
  185.       (if docref-highlight-p          
  186. ;;      XEmacs: we support faces on TTY's.
  187. ;;      (if (not window-system)
  188. ;;          (setq label
  189. ;;            (concat (substring label 0 leading-space-end)
  190. ;;                "(*note "
  191. ;;                (substring label leading-space-end trailing-space-start)
  192. ;;                ")"
  193. ;;                (substring label trailing-space-start)))
  194.         ;; window-system
  195.         (put-text-property leading-space-end
  196.                    trailing-space-start
  197.                    'face docref-highlight-face label))
  198.       (put-text-property 0 (length label) 'docref ref label)
  199.       (insert label))))
  200.  
  201. (defun docref-follow-mouse (click)
  202.   "Follow the cross-reference that you click on."
  203.   (interactive "e")
  204.   (save-excursion
  205.     ;; XEmacs changes here.
  206.     (let* ((window (event-window click))
  207.        (pos (event-point click))
  208.        (docref-last-active-buffer (current-buffer)))
  209.       (set-buffer (window-buffer window))
  210.       (docref-follow pos))))
  211.  
  212. (defun docref-go-back ()
  213.   "Go back to the previous contents of help buffer."
  214.   (interactive)
  215.   (let ((pos (get-text-property (point-min) 'docref-back-position)))
  216.     (if    pos
  217.     (docref-follow pos)
  218.       (error "No go-back reference"))))
  219.  
  220. (defun docref-follow (&optional pos)
  221.   "Follow cross-reference at point.
  222. For the cross-reference format, see \\(f@docref-subst).
  223. The special reference named `back' can be used to return back"
  224.   (interactive)
  225.   (or pos (setq pos (point)))
  226.   (let ((docref-data (get-text-property pos 'docref)))
  227.     (if docref-data
  228.     ;; There is a reference at point.  Follow it.
  229.     (let* ((type (car docref-data))
  230.            (name (cdr docref-data))
  231.            (method (assoc type docref-methods-alist))
  232.            (cur-contents (buffer-string))
  233.            (opoint (point))
  234.            (docref-back-reference (cons "s" cur-contents))
  235.            success)
  236.       (if (null method)
  237.           (error "Unknown cross-reference type: %s" type))
  238.       (unwind-protect
  239.           (save-excursion
  240.         (funcall (cdr method) name)
  241.         (setq success t))
  242.         (or success
  243.         (progn
  244.           ;; (cdr method) got an error.
  245.           ;; Put back the text that we had.
  246.           (erase-buffer)
  247.           (insert cur-contents)
  248.           (goto-char opoint)))
  249.         (set-buffer-modified-p nil))))))
  250.  
  251. ;; Builtin methods for accessing a reference.
  252.  
  253. (defun docref-describe-function (data)
  254.   (save-excursion
  255.     (if (boundp 'docref-last-active-buffer)
  256.     (set-buffer docref-last-active-buffer))
  257.     (describe-function (intern data))))
  258.   
  259. (defun docref-describe-variable (data)
  260.   (save-excursion
  261.     (if (boundp 'docref-last-active-buffer)
  262.     (set-buffer docref-last-active-buffer))
  263.     (describe-variable (intern data))))
  264.  
  265. (defun docref-read-file (data)
  266.   (with-output-to-temp-buffer (buffer-name)
  267.     (erase-buffer)
  268.     (insert-file-contents (expand-file-name data))))
  269.  
  270. (defun docref-use-string (data)
  271.   (with-output-to-temp-buffer (buffer-name)
  272.     (erase-buffer)
  273.     (insert data)))
  274.  
  275. (defun docref-use-variable-value (data)
  276.   (let ((sym (intern data)))
  277.     (with-output-to-temp-buffer (buffer-name)
  278.       (erase-buffer)
  279.       (princ (symbol-value sym)))))
  280.  
  281. (provide 'docref)
  282.  
  283. ;;; docref.el ends here
  284.  
  285.